Feb 23rd
Rikiya Honda
2022-02-23
課題１：次の自動車課題について「データセット」を探し，データ分析を行う。
データセット
データセットの呼び出しを行う
データの読み込み（インポート）
- データの読み込み（※ディレクトリについて） ここでは，主にCSV(Comma Separated Values)ファイルの読み込みについて説明する。 （注）ディレクトリについて ・Windowsではメニュー「ファイル」→「ディレクトリの変更」で指定できる ・Macではメニュー「その他」→「作業ディレクトリの変更」 実際に，それぞれの環境の中でデータを読み込むときは，ディレクトリの理解が不可欠になる。 例えば，JドライブのRフォルダにある”sheet1.csv”を読み込むときは次のようにする （学院のPC教室ではJドライブに資料を格納しておく）。
2．基本統計量の計算
平均値・最大値・最小値・中央値
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00回帰直線を方程式を求める
## (Intercept) speed
## -17.579095 3.932409上記の結果から、今回の回帰係数は、切片が-17.5790949で、傾きが3.9324088であることがわかる。これを線形の式に直すと、以下の通りになる。
\[ dist = -17.5790949 + 3.9324088 \times speed \]
6．残差（テキストp.83）の絶対値が比較的大きいデータに注目し、自身の考察を書きなさい。
残差を求める
# define the dataset `cars_result`
cars_result <- data.frame(cars,
resid = resid(cars.lm), # residuals of the linear model
resid_abs = abs(resid(cars.lm)) # absolute value of the residuals
)並び替える
# order `cars_result`
head(cars_result[sort(cars_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)## speed dist resid resid_abs
## 49 24 120 43.20128 43.20128
## 23 14 80 42.52537 42.52537
## 35 18 84 30.79574 30.79574
## 39 20 32 -29.06908 29.06908
## 34 18 76 22.79574 22.79574
## 22 14 60 22.52537 22.52537
## 24 15 20 -21.40704 21.40704
## 36 19 36 -21.13667 21.13667
## 45 23 54 -18.86631 18.86631
## 29 17 32 -17.27185 17.271857．自己ワーク
国土交通省の資料「安全な車に乗ろう」 国土交通省の資料「安全な車に乗ろう」なども参考にし，安全な自動車を設計するために必要な実験や調査を考えたとき，対象となる変量はどのようなものが考えられるだろうか。そして，そこにはどのような因果関係があるか考察しよう。
対象となる変数
- ABSの有無
仮説
- ABSの有無がそのスピードから停止する距離に影響する。
実験 ABSを装備した自動車のと、通常のブレーキを装備した自動車のグループを用意し、同じ条件下で、あるスピードから停止するのにかかる時間を計測する。その後、スピードを説明変数とし、停止距離を目的変数とした回帰モデルにおけるそれぞれの傾きを比較し、ABSが装備されているか否かで停止距離に影響があるのかを検証する。
回帰モデル ABSを装備した自動車をAグループとし、通常のブレーキを装備した自動車をBグループとする。
\[ dist_A = \beta_{1_A} + \beta_{2_A} speed_A + u_A \]
\[ dist_B = \beta_{1_B} + \beta_{2_B} speed_B + u_B \]
上記の回帰モデルを走らせた後、\(\beta_{2_A}\)と\(\beta_{2_B}\)を比べ、違いがあるのかを検証する。
ファイル提出
コード等をwordに貼って、ファイルを提出する
課題２：自分の関心のある課題について「データセット」を探しデータ分析を行い，その結果について回帰分析を考察する。
- 対象となる変数
- 説明変数: 攻撃力
- 目的変数: 防御力
- 仮説
- 防御力が強くなると、攻撃力も強くなる傾向がある。
データセットの呼び出しを行う
データの読み込み（インポート）
- データの読み込み（※ディレクトリについて） ここでは，主にCSV(Comma Separated Values)ファイルの読み込みについて説明する。 （注）ディレクトリについて ・Windowsではメニュー「ファイル」→「ディレクトリの変更」で指定できる ・Macではメニュー「その他」→「作業ディレクトリの変更」 実際に，それぞれの環境の中でデータを読み込むときは，ディレクトリの理解が不可欠になる。 例えば，JドライブのRフォルダにある”sheet1.csv”を読み込むときは次のようにする （学院のPC教室ではJドライブに資料を格納しておく）。
1. データの提示
## X name year selling_price km_driven fuel seller_type
## 1 1 Maruti 800 AC 2007 60000 70000 Petrol Individual
## 2 2 Maruti Wagon R LXI Minor 2007 135000 50000 Petrol Individual
## 3 3 Hyundai Verna 1.6 SX 2012 600000 100000 Diesel Individual
## 4 4 Datsun RediGO T Option 2017 250000 46000 Petrol Individual
## 5 5 Honda Amaze VX i-DTEC 2014 450000 141000 Diesel Individual
## 6 6 Maruti Alto LX BSIII 2007 140000 125000 Petrol Individual
## transmission owner
## 1 Manual First Owner
## 2 Manual First Owner
## 3 Manual First Owner
## 4 Manual First Owner
## 5 Manual Second Owner
## 6 Manual First Owner2．基本統計量の計算
平均値・最大値・最小値・中央値
## X name year selling_price
## Min. : 1 Length:4340 Min. :1992 Min. : 20000
## 1st Qu.:1086 Class :character 1st Qu.:2011 1st Qu.: 208750
## Median :2170 Mode :character Median :2014 Median : 350000
## Mean :2170 Mean :2013 Mean : 504127
## 3rd Qu.:3255 3rd Qu.:2016 3rd Qu.: 600000
## Max. :4340 Max. :2020 Max. :8900000
## km_driven fuel seller_type transmission
## Min. : 1 Length:4340 Length:4340 Length:4340
## 1st Qu.: 35000 Class :character Class :character Class :character
## Median : 60000 Mode :character Mode :character Mode :character
## Mean : 66216
## 3rd Qu.: 90000
## Max. :806599
## owner
## Length:4340
## Class :character
## Mode :character
##
##
## 不偏分散
## $selling_price
## [1] 334718640088
##
## $km_driven
## [1] 2175672269回帰直線を方程式を求める
## (Intercept) km_driven
## 662055.007854 -2.385046上記の結果から、今回の回帰係数は、切片が6.620550110^{5}で、傾きが-2.3850463であることがわかる。これを線形の式に直すと、以下の通りになる。
\[ selling_price = 6.6205501\times 10^{5} + -2.3850463 \times km_driven \]
5. 散布図および回帰直線の描画
plot(data$km_driven, data$selling_price,
xlab = "Driven Distan (km)",
ylab = "Selling Prise ($)"
)
abline(data.lm, col = "darkred", lwd = 2)
6．残差（テキストp.83）の絶対値が比較的大きいデータに注目し、自身の考察を書きなさい。
残差を求める
# define the dataset `data_result`
data_result <- data.frame(data,
resid = resid(data.lm), # residuals of the linear model
resid_abs = abs(resid(data.lm)) # absolute value of the residuals
)並び替える
# order `data_result`
head(data_result[sort(data_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)## X name year selling_price
## 3873 3873 Audi RS7 2015-2019 Sportback Performance 2016 8900000
## 90 90 Mercedes-Benz S-Class S 350d Connoisseurs Edition 2017 8150000
## 3970 3970 Mercedes-Benz GLS 2016-2020 350d 4MATIC 2016 5500000
## 556 556 BMW X5 xDrive 30d xLine 2019 4950000
## 575 575 BMW X5 xDrive 30d xLine 2019 4950000
## 594 594 BMW X5 xDrive 30d xLine 2019 4950000
## 613 613 BMW X5 xDrive 30d xLine 2019 4950000
## 901 901 BMW X5 xDrive 30d xLine 2019 4950000
## 920 920 BMW X5 xDrive 30d xLine 2019 4950000
## 1024 1024 BMW X5 xDrive 30d xLine 2019 4950000
## km_driven fuel seller_type transmission owner resid resid_abs
## 3873 13000 Petrol Dealer Automatic First Owner 8268951 8268951
## 90 6500 Diesel Dealer Automatic First Owner 7503448 7503448
## 3970 77350 Diesel Dealer Automatic First Owner 5022428 5022428
## 556 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 575 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 594 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 613 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 901 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 920 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 1024 30000 Diesel Dealer Automatic First Owner 4359496 4359496考察
仮説：中古車ののデータから、走行距離が売却価格に対して負の影響をもつ。
モデルの説明
- 目的変数: 売却価格
- 説明変数: 走行距離
結果 $ sellingprice = 662055.007854 + -2.385046 kmdriven$
うまくいかなかった。残渣を見ればわかる。
- 考察 (なぜうまくいかなかったのか)
- ブランド車に対して、回帰直線のモデルがうまく説明できていないのではないか。ブランドごとに回帰直線を回したほうがいいのかもしれない。
- 取引価格が高いと、モデルがうまく説明できなくなるのではないか。
- デーラー経由だとセールス力があるため、値段が高騰する傾向があるのではないか？もしくは、査定代が取引価格に上乗せされているのではないか？
APPENDIX
予測値と残差
残渣(residuals)は、実際の値と予測値の差分で計算される。
以下の図だと、予測値の青の線と実際の値である赤の線の間が残差である。
# load packages
library(tidyverse)
library(modelr)
library(scales)
library(plotly)
# define the data for visualization
data_plot <- data %>%
add_predictions(data.lm) %>%
add_residuals(data.lm) %>%
pivot_longer(cols = c(selling_price, pred, resid), names_to = "vars", values_to = "value")
# raw v.s. expected value
data_plot %>%
filter(vars != "resid") %>%
ggplot(aes(km_driven, value, lable = name, color = vars)) +
geom_point() +
geom_line() +
scale_x_continuous(labels = comma) +
scale_y_continuous(labels = comma) +
labs(title = "The scatter plot of the predicted value",
x = "Driven distance (km)",
y = "Selling Price",
color = "Name") +
theme_minimal()
実際の値であるスピードの変化によって生じる残差の値を、グラフ化したのが以下の図になる。
library(ggrepel)
# residual
g1 <-
data_plot %>%
filter(vars == "resid") %>%
ggplot(aes(km_driven, value, label = name)) +
geom_hline(yintercept = 0, colour = "black", linetype = "dashed") +
geom_point() +
geom_line() +
# geom_label_repel(nudge_x = TRUE, nudge_y = TRUE, check_overlap = TRUE) +
labs(title = "The scatter plot of the residual",
x = "Driven Distance (km)",
y = "Residuals") +
theme_minimal()
ggplotly(g1)